home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / pump_src / setup / pastst.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-25  |  9.5 KB  |  363 lines
  1. (* ------------------------ PASTST.PAS ---------------------- *)
  2. (* DemoVT 1.5 Pascal example bye Jare/Iguana.                 *)
  3.  
  4. (* This thing shows how to create volume bars with DemoVT 1.5 *)
  5. (* You have three types: by channels, instruments or notes.   *)
  6.  
  7. (* Channel bars are launched when DemoVT tells. ChansTrig[].  *)
  8. (* Inst. and note bars are launched when any channel triggers *)
  9. (* that instrument or note. Notes range from $14 to $6B0, but *)
  10. (* most will do in the range shown here.                      *)
  11.  
  12. (* CARE: notes are logarithmic, they're really 1/frequency.   *)
  13.  
  14. {$A+,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X+}
  15.  
  16. USES PasDVT, Crt;
  17.  
  18. TYPE
  19.    TScrB = ARRAY [0..24,0..79,0..1] OF BYTE;
  20.    TScrW = ARRAY [0..24,0..79] OF WORD;
  21. VAR
  22.    ScrB : TScrB ABSOLUTE $B800:0000;
  23.    ScrW : TScrW ABSOLUTE $B800:0000;
  24.  
  25. CONST
  26.    MAXCHANS =  8;
  27.    MAXBARCH = 32;
  28.  
  29.    NUMSAMPS = 31;
  30.    MAXBARSA = 24;
  31.  
  32.    NUMFREQS = 64;
  33.    MINFREQ  = $14;
  34.    MAXFREQ  = $3B0;
  35.    MAXBARFR = 24;
  36.  
  37.    MAXVOL   = 64;
  38.  
  39. VAR
  40.    Chans     : ARRAY [1..MAXCHANS] OF INTEGER;
  41.    Samps     : ARRAY [1..NUMSAMPS] OF INTEGER;
  42.    Freqs     : ARRAY [1..NUMFREQS] OF INTEGER;
  43.    OFreqs    : ARRAY [1..NUMFREQS] OF INTEGER;
  44.    SampsChan : ARRAY [1..NUMSAMPS] OF BYTE;
  45.    FreqsChan : ARRAY [1..NUMFREQS] OF BYTE;
  46.  
  47.    OldVMode : BYTE;
  48.  
  49.    NumChans : INTEGER;
  50.  
  51.  
  52. PROCEDURE InitScr;
  53.    CONST
  54.       BOXATTR = $300;
  55.    VAR
  56.       i : INTEGER;
  57.    BEGIN
  58.       ASM
  59.          MOV   AH,0Fh
  60.          INT   10h
  61.          MOV   [OldVMode],AL
  62.          MOV   AX,3
  63.          INT   10h
  64.       END;
  65.  
  66.       FOR i := 0 TO 63 DO BEGIN
  67.          ScrW[11,i] := WORD(BYTE('─') + BOXATTR);
  68.          ScrW[13,i] := WORD(BYTE('─') + BOXATTR);
  69.  
  70.          ScrW[ 0,i] := $220;
  71.          ScrW[ 1,i] := $220;
  72.          ScrW[ 2,i] := $220;
  73.          ScrW[ 3,i] := $220;
  74.          ScrW[ 4,i] := $A20;
  75.          ScrW[ 5,i] := $A20;
  76.          ScrW[ 6,i] := $A20;
  77.          ScrW[ 7,i] := $A20;
  78.          ScrW[ 8,i] := $C20;
  79.          ScrW[ 9,i] := $C20;
  80.          ScrW[10,i] := $420;
  81.          ScrW[14,i] := $420;
  82.          ScrW[15,i] := $C20;
  83.          ScrW[16,i] := $C20;
  84.          ScrW[17,i] := $A20;
  85.          ScrW[18,i] := $A20;
  86.          ScrW[19,i] := $A20;
  87.          ScrW[20,i] := $A20;
  88.          ScrW[21,i] := $220;
  89.          ScrW[22,i] := $220;
  90.          ScrW[23,i] := $220;
  91.          ScrW[24,i] := $220;
  92.       END;
  93.  
  94.       FOR i := 0 TO 24 DO BEGIN
  95.          ScrW[i,64] := WORD(BYTE('│') + BOXATTR);
  96.  
  97.          ScrW[i,65] := $420;
  98.          ScrW[i,66] := $420;
  99.          ScrW[i,67] := $C20;
  100.          ScrW[i,68] := $C20;
  101.          ScrW[i,69] := $C20;
  102.          ScrW[i,70] := $A20;
  103.          ScrW[i,71] := $A20;
  104.          ScrW[i,72] := $A20;
  105.          ScrW[i,73] := $A20;
  106.          ScrW[i,74] := $A20;
  107.          ScrW[i,75] := $220;
  108.          ScrW[i,76] := $220;
  109.          ScrW[i,77] := $220;
  110.          ScrW[i,78] := $220;
  111.          ScrW[i,79] := $220;
  112.       END;
  113.  
  114.       ScrW[11,0] := WORD(BYTE('┌') + BOXATTR);
  115.       ScrW[12,0] := WORD(BYTE('│') + BOXATTR);
  116.       ScrW[13,0] := WORD(BYTE('└') + BOXATTR);
  117.  
  118.       ScrW[11,64] := WORD(BYTE('┤') + BOXATTR);
  119.       ScrW[13,64] := WORD(BYTE('┤') + BOXATTR);
  120.  
  121.       FOR i := 1 TO AppIdFound^[0] DO
  122.          ScrW[12,i] := AppIdFound^[i] + $1E00;
  123.  
  124.       ScrB[0,0,1] := 0        { Hide cursor at (0,0). }
  125.    END;
  126.  
  127.  
  128. PROCEDURE UpdateScr;
  129.    VAR
  130.       i, j, k, l, h: INTEGER;
  131.       Patt, Note : byte;
  132.       PattStr, NoteStr : STRING[2];
  133.    BEGIN
  134.  
  135.       VT_CurrentPos( Patt, Note );
  136.       STR( Patt : 2, PattStr);
  137.       STR( Note : 2, NoteStr);
  138.  
  139.       IF NoteStr[1] = ' ' THEN NoteStr[1] := '0';
  140.  
  141.       j := 59;
  142.       FOR i := 1 TO Length(PattStr) DO
  143.          BEGIN
  144.             ScrW[12,j] := BYTE(PattStr[i]) + $1F00;
  145.             INC(j);
  146.          END;
  147.       ScrW[12,j] := BYTE('/') + $1F00;
  148.       INC(j);
  149.       FOR i := 1 TO Length(NoteStr) DO
  150.          BEGIN
  151.             ScrW[12,j] := BYTE(NoteStr[i]) + $1F00;
  152.             INC(j);
  153.          END;
  154.  
  155.  
  156.  
  157.       h := 25 DIV NumChans;   { NOTE: h = 0 if NumChans > 12. }
  158.                               { This results in missing bars. }
  159.  
  160.       FOR i := 1 TO NumChans DO BEGIN
  161.          l := Chans[i] DIV 2;
  162.          FOR j := 0 TO l-1 DO
  163.             FOR k := 1 TO h-1 DO
  164.                ScrB[h*i-h+k, 79-j, 0] := BYTE('█');
  165.          IF l <= 14 THEN
  166.             IF (Chans[i] MOD 2) = 1 THEN
  167.                FOR k := 1 TO h-1 DO
  168.                   ScrB[h*i-h+k, 79-l, 0] := BYTE('▐')
  169.             ELSE
  170.                FOR k := 1 TO h-1 DO
  171.                   ScrB[h*i-h+k, 79-l, 0] := BYTE(' ');
  172.          FOR j := l+1 TO 14 DO
  173.             FOR k := 1 TO h-1 DO
  174.                ScrB[h*i-h+k, 79-j, 0] := BYTE(' ')
  175.       END;
  176.  
  177.       FOR i := 1 TO NUMSAMPS DO BEGIN
  178.          l := Samps[i] DIV 2;
  179.          FOR j := 0 TO l-1 DO
  180.             ScrB[j, 2*i, 0] := BYTE('█');
  181.          IF l <= 10 THEN
  182.             IF (Samps[i] MOD 2) = 1 THEN
  183.                ScrB[l, 2*i, 0] := BYTE('▀')
  184.             ELSE
  185.                ScrB[l, 2*i, 0] := BYTE(' ');
  186.          FOR j := l+1 TO 10 DO
  187.             ScrB[j, 2*i, 0] := BYTE(' ')
  188.       END;
  189.  
  190.       FOR i := 1 TO NUMFREQS DO BEGIN
  191.          l := Freqs[i] DIV 2;
  192.          FOR j := 0 TO l-1 DO
  193.             ScrB[24-j, i-1, 0] := BYTE('█');
  194.          IF l <= 10 THEN
  195.             IF (Freqs[i] MOD 2) = 1 THEN
  196.                ScrB[24-l, i-1, 0] := BYTE('▄')
  197.             ELSE
  198.                ScrB[24-l, i-1, 0] := BYTE(' ');
  199.          FOR j := l+1 TO 10 DO
  200.             ScrB[24-j, i-1, 0] := BYTE(' ')
  201.       END
  202.    END;
  203.  
  204. VAR
  205.    i, j, v, p : INTEGER;
  206.    fading, faded : BOOLEAN;
  207.    fadevol : INTEGER;
  208.    ticksToGo : LONGINT;
  209.  
  210.    period : word;
  211.    instrument, volume : byte;
  212.    triggered : boolean;
  213.  
  214. BEGIN
  215.    WriteLn('PASTST: DemoVT''s Pascal interface example.');
  216.  
  217.    IF NOT VT_Init THEN BEGIN                    { Init DEMOVT           }
  218.      WriteLn('DEMOVT not detected!');           { check if DEMOVT a-ok  }
  219.      HALT(1);
  220.    END;
  221.  
  222.    NumChans := VT_ChannelCount;
  223.  
  224.    FOR i := 1 TO NumChans DO
  225.        Chans[i] := 0;
  226.    FOR i := 1 TO NUMSAMPS DO BEGIN
  227.        Samps[i] := 0;
  228.        SampsChan[i] := 0
  229.    END;
  230.    FOR i := 1 TO NUMFREQS DO BEGIN
  231.        Freqs[i] := 0;
  232.        FreqsChan[i] := 0
  233.    END;
  234.  
  235.    VT_GoTo(1, 1);
  236.    VT_AutoOn;                                        { turn on timer control }
  237. VT_AutoOff;
  238.    VT_SetVolume(255);
  239.    Write('Waiting for music to start sounding... ');
  240.    VT_SyncStart;             { start playing music and delay for 1/2 second  }
  241.    fadevol := 255;
  242.    fading := FALSE;
  243.    faded  := FALSE;
  244.    InitScr;
  245.  
  246.  
  247.    REPEAT
  248.       VT_Delay(2);
  249.  
  250.       FOR i := 1 TO NumChans DO BEGIN
  251.  
  252.          VT_ChStatus( i, period, instrument, volume );
  253.          triggered := VT_QueryCh( i );
  254.  
  255.          IF period < MINFREQ THEN
  256.             p := 1
  257.          ELSE IF period >= MAXFREQ THEN
  258.             p := NUMFREQS
  259.          ELSE
  260.             p := 1+LONGINT(NUMFREQS)*(period - MINFREQ)
  261.                    DIV (MAXFREQ-MINFREQ);
  262.  
  263.          p := NUMFREQS+1-p;
  264.  
  265.          IF (OFreqs[i] <> p) OR triggered THEN
  266.             BEGIN
  267.                v := MAXBARFR*INTEGER(volume) DIV MAXVOL;
  268.                INC(Freqs[p], v);
  269.                IF p > 1 THEN
  270.                   INC(Freqs[p-1], v DIV 2);
  271.                IF p > 2 THEN
  272.                   INC(Freqs[p-2], v DIV 4);
  273.                IF p < NUMFREQS THEN
  274.                   INC(Freqs[p+1], v DIV 2);
  275.                IF p < NUMFREQS-1 THEN
  276.                   INC(Freqs[p+2], v DIV 4);
  277.             END;
  278.          OFreqs[i] := p;
  279.  
  280.          FOR j := p-2 TO p+2 DO
  281.             IF (j >= 1) AND (j <= NUMFREQS) THEN
  282.                IF Freqs[j] > MAXBARFR THEN
  283.                   Freqs[j] := MAXBARFR;
  284.  
  285.  
  286. (*
  287.          IF (instrument > 0)
  288.              AND (instrument <= NUMSAMPS)
  289.              AND (SampsChan[instrument] <> i) THEN BEGIN
  290.             Samps[instrument]     :=
  291.                MAXBARSA*INTEGER(volume) DIV MAXVOL;
  292.             SampsChan[instrument] := i
  293.          END;
  294.  
  295.          IF FreqsChan[p] <> i THEN BEGIN
  296.             Freqs[p]     := MAXBARFR*INTEGER(volume)
  297.                             DIV MAXVOL;
  298.             FreqsChan[p] := i
  299.          END;
  300. *)
  301.          IF triggered THEN BEGIN
  302.             Chans[i] := MAXBARCH*INTEGER(volume)
  303.                         DIV MAXVOL;
  304.  
  305.             IF (instrument > 0)
  306.                 AND (instrument <= NUMSAMPS) THEN BEGIN
  307.                Samps[instrument] :=
  308.                   MAXBARSA*INTEGER(volume) DIV MAXVOL;
  309.                SampsChan[instrument] := i;
  310.             END;
  311.  
  312. {
  313.             Freqs[p]     := MAXBARFR*INTEGER(volume)
  314.                             DIV MAXVOL;
  315.             FreqsChan[p] := i;
  316. }
  317.  
  318.          END ELSE BEGIN
  319.             IF Chans[i] > 0 THEN
  320.                DEC (Chans[i]);
  321.          END;
  322.       END;
  323.  
  324.       FOR i := 1 TO NUMFREQS DO
  325.          IF Freqs[i] > 0 THEN
  326.             DEC(Freqs[i]);
  327.  
  328.       FOR i := 1 TO NUMSAMPS DO
  329.          IF Samps[i] > 0 THEN
  330.             DEC(Samps[i]);
  331.  
  332.       UpdateScr;
  333.  
  334.       IF KeyPressed THEN BEGIN
  335.          ReadKey;
  336.          fading := TRUE
  337.       END;
  338.       IF fading THEN BEGIN
  339.          IF fadevol <= 0 THEN
  340.             faded := (ticksToGo + 50) <= VT_Timer
  341.          ELSE BEGIN
  342.             VT_SetVolume(fadevol);
  343.             DEC(fadevol,2);
  344.             IF fadevol <= 0 THEN
  345.                ticksToGo := VT_Timer
  346.          END
  347.       END
  348.    UNTIL faded;
  349.  
  350.    VT_AutoOff;
  351.  
  352.    ASM
  353.       MOV   AL,[OldVMode]
  354.       XOR   AH,AH
  355.       INT   10h
  356.    END;
  357.  
  358.    VT_Abort;
  359. END.
  360.  
  361.  
  362. (* ------------------------ PASTST.PAS ---------------------- *)
  363.